home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / oekaki32 / oekaki32.bas < prev    next >
BASIC Source File  |  1993-07-08  |  31KB  |  677 lines
  1. 10 '********************************************************************
  2. 20 '    お絵描き３２Ｋ  V1.2001
  3. 30 '            F-BASIC386 V1.1 L21以降   Copyright(C) おこめ 1993
  4. 40 '********************************************************************
  5. 50 CLS:LOCATE 30,12:PRINT "お絵描き３２Ｋ"
  6. 60 CLEAR ,,512,FRE(4)-80000,0:ON ERROR GOTO *ERR
  7. 70 DEFINT A-F,H-Z:MOUSE 0:KI=23-1
  8. 80 DIM B(16383),VA(5455),B$(255),ER$(127),ER(10),ERM(25855):GOSUB *ERRM
  9. 90 DIM A(KI),D(16455),VZ(16383),P(127),M(2,2),EGX(4),EGY(4),EM(4)
  10. 100 DIM GP(4),GP2(4),GPX(4),GPY(4):V&=FRE(3)\2-20:DIM V(V&):MODE=1
  11. 110 SMODE=1:XN2=32:YN2=32:MKNO=1:MNO=1:EG=8:L=3:V2=-1
  12. 120 FOR I=0 TO 4:EGX(I)=200+2^I*2:EGY(I)=23:NEXT:SCREEN@0
  13. 130 FOR I=1 TO 4:EM(I)=EM(I-1)+(2*2^I)^2:NEXT
  14. 140 DEF FNSX(MX)=((MX-XK)\XB)+WX:DEF FNSY(MY)=((MY-YK)\YB)+WY
  15. 150 DEF FNMX(MX)=((MX-XK)\XB)*XB+XK-1:DEF FNMY(MY)=((MY-YK)\YB)*YB+YK
  16. 160 M(0,0)=255:M(0,1)=255:M(0,2)=255
  17. 170 *S1 MOUSE 1:SCREEN@MODE:COLOR 7,0,7,4:CLS:WIDTH 80,25:CONSOLE 24,1,0:GOSUB *WO:IF SMODE=3 THEN SPRITE ON
  18. 180 A$=CHR$(127,255,63,255,31,255,15,255,7,255,3,255,1,255,0,255,0,127,0,63,0,31,0,31,0,127,0,255,16,255,56,255)
  19. 190 B$=CHR$(0,0,0,0,64,0,96,0,48,0,88,0,60,0,94,0,47,0,95,128,47,0,84,0,70,0,2):MOUSE 2,A$,B$
  20. 200 *GA LINE(0,0)-(319,19),PSET,[127,127,127],BF
  21. 210 RESTORE 210
  22. 220 READ I:IF I=-1 THEN 270
  23. 230 LINE(I*20+2,2)-STEP(16,16),PSET,0,BF
  24. 240 LINE STEP(-1,-1)-STEP(-16,-16),PSET,0,BF,7
  25. 250 GOTO 220
  26. 260 DATA 0,12,13,14,15,-1
  27. 270 SYMBOL(3,3),"絵",.9!,.9!,0
  28. 280 SYMBOL(283,3),"CD",.9!,.9!,0
  29. 290 SYMBOL(243,3),"元",.9!,.9!,0
  30. 300 SYMBOL(303,3),"終",.9!,.9!,0
  31. 310 LINE(263,4)-(267,8),PSET,0,B
  32. 320 LINE(267,4)-(275,12),PSET,0,B
  33. 330 LINE(0,20)-(319,279),PSET,[140,140,140],BF
  34. 340 SYMBOL(40,2),"お絵描き３２Ｋ　Ｖ１.２００１",.5!,.5!,0,,,1
  35. 350 GOSUB *MODE:GOSUB *EDP:GOSUB *拡大:GOSUB *WA
  36. 360 GOTO *M2
  37. 370 *MODE WX=EGX(L):WY=EGY(L):BY=97:XK=41:YK=56
  38. 380 BX4=128:BX=320-BX4:BX3=BX4-1:BX2=BX+BX3
  39. 390 XN=XN2-1:XB=128\XN2:XB2=XB-1:XK3=XN2*XB:XK2=XK+XK3-1
  40. 400 BY4=128:BY3=BY4-1:BY2=BY+BY3
  41. 410 YN=YN2-1:YB=128\YN2:YB2=YB-1:YK3=YN2*YB:YK2=YK+YK3-1
  42. 420 EV=INT(V&/BX4/BY4)
  43. 430 IF V>EV THEN V=0
  44. 440 RETURN
  45. 450 *M2 FOR Y=0 TO 2:FOR X=0 TO 255 STEP 8:LINE(X\2+1,201+Y*6)-(X\2+4,206+Y*6),PSET,[-X*(Y=0),-X*(Y=1),-X*(Y=2)],BF:NEXT
  46. 460 LINE(M(2,Y)\2+1,202+Y*6)-(M(2,Y)\2+4,205+Y*6),XOR,7,B:NEXT
  47. 470 LINE(130,201)-(136,219),PSET,[M(2,0),M(2,1),M(2,2)],BF
  48. 480 LINE(0,200)-(129,219),PSET,7,B:LINE(129,200)-(137,219),PSET,7,B
  49. 490 LINE(140,200)-(148,219),PSET,7,BF,[M(0,0),M(0,1),M(0,2)]
  50. 500 LINE(150,200)-(158,219),PSET,7,BF,[M(1,0),M(1,1),M(1,2)]
  51. 510 FOR X=0 TO 7:CIRCLE(X*8+4,192),X,7,1,,,F:NEXT:GOSUB *MPE
  52. 520 RESTORE 530:FOR X=0 TO KI:LINE((X MOD 2)*16+2,(X\2)*10+25)-STEP(16,10),PSET,0,BF:READ A(X):LINE STEP(-17,-11)-STEP(16,10),PSET,0,BF,[255-A(X)*50,255-A(X)*50,255-A(X)*50]:NEXT
  53. 530 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,2,1,1,1,1,1,1,1,1,1
  54. 540 FOR Y=0 TO 3:FOR X=0 TO 1
  55. 550 READ A$:SYMBOL(5+X*16,26+Y*10),A$,.5!,.5!,0:NEXT X,Y:PAINT(23,58),0
  56. 560 DATA ・,／,□,■,○,●,〇,〇
  57. 570 SYMBOL(2,72),"⇔",.45!,.5!,0,1
  58. 580 SYMBOL(9,66),"転",.45!,.5!,0:SYMBOL(18,66),"⇔転",.45!,.5!,0
  59. 590 SYMBOL(1,76),"COPY",.45!,.5!,0:SYMBOL(18,76),"MOVE",.45!,.5!,0
  60. 600 SYMBOL(1,86),"PAINT",.4!,.5!,0:SYMBOL(17,86),"SPOIT",.4!,.5!,0
  61. 610 SYMBOL(5,96),"⇔",.5!,.5!,0:SYMBOL(21,96),"←",.5!,.5!,0
  62. 620 SYMBOL(2,106),"ｺﾋﾟｰ",.45!,.5!,0:SYMBOL(18,106),"ﾍﾟｰｽﾄ",.4!,.5!,0
  63. 630 SYMBOL(3,116),"楕円",.45!,.5!,0:SYMBOL(17,116),"色々",.5!,.5!,0
  64. 640 SYMBOL(1,126),"NEKO",.45!,.5!,0:SYMBOL(17,126),"FANT",.45!,.5!,0
  65. 650 SYMBOL(5,136),"☆",.5!,.5!,0
  66. 660 Z=MNO+14:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH
  67. 670 MOUSE 1,160,120:GOSUB *ESCP
  68. 680 ER=0:GOSUB *MUON
  69. 690 A$=INKEY$:IF A$="" THEN GOSUB *MOUSE:GOTO 690
  70. 700 GOSUB *MUSTP
  71. 710 IF A$=CHR$(9) OR A$=CHR$(22) THEN GOSUB *ESC2
  72. 720 IF A$=CHR$(8) THEN M0=0:M1=-1:GOSUB *MDO
  73. 730 IF A$=CHR$(23) OR A$=CHR$(27) THEN GOSUB *ESC
  74. 740 IF A$=CHR$(16) THEN GOSUB *連続2
  75. 750 IF A$=CHR$(11) THEN GOSUB *ESCG:V=0:V2=-1:GOSUB *ESCP:GOSUB *率:GOSUB *WA
  76. 760 IF A$="*" THEN GOSUB *WA
  77. 770 IF A$="/" THEN GOSUB *率
  78. 780 IF A$="-" THEN GOSUB *拡大
  79. 790 IF A$<"A" THEN 810
  80. 800 ON ASC(A$)-64 GOSUB *WQA,*反転,*CLS,*BCLS,*END,*SUD,*SLR,*B反転,*DLOAD,*ANIM,*S回転,*GLOAD,*率,*B拡大,*DSAVE,*変換,*WQU,*SROLL,*GSAVE,*BROLL,*DS16,*WAVEX,*WAVEY,*BLR,*B回転,*BUD
  81. 810 IF A$="j" THEN GOSUB *MAZE
  82. 820 IF A$="m" THEN GOSUB *面塗
  83. 830 IF A$="p" THEN GOSUB *連続
  84. 840 IF A$="s" THEN GOSUB *GFSA
  85. 850 IF A$="y" THEN GOSUB *B右回転
  86. 860 IF A$="k" THEN GOSUB *S右回転
  87. 870 GOTO 680
  88. 880 *END GOSUB *ESCG:GOSUB *EDG:WIDTH 80,25:END:MOUSE 0:RETURN *S1
  89. 890 *MUSTP MUSW=0:MOUSE 1:RETURN
  90. 900 *MUON MUSW=1:MOUSE 1,,,1:RETURN
  91. 910 *WA LINE(XK-1,YK-1)-(XK2+1,YK2+1),PSET,7,B
  92. 920 FOR I=2 TO YN-1 STEP 2:LINE(XK,YK+YB*I)-(XK+XB2+XB*XN,YK+YB*I),PSET,[127,127,127]:NEXT
  93. 930 FOR I=2 TO XN-1 STEP 2:LINE(XK-1+XB*I,YK)-(XK-1+XB*I,YK+YB+YB*YN-1),PSET,[127,127,127]:NEXT
  94. 940 LINE(WX-1,WY-1)-(WX+XN+1,WY+YN+1),PSET,7,B:GOTO *JN
  95. 950 *拡大 GET@A(WX,WY)-(WX+XN,WY+YN),B
  96. 960 PUT@A(XK,YK)-(XK+XN,YK+YN),B,,XK3/XN2,YK3/YN2
  97. 970 *字 LOCATE 0,24:PRINT SPC(79);:LOCATE 0,24:RETURN
  98. 980 *JN FOR I=0 TO 15
  99. 990 SYMBOL(BX+(BX4\16)*I,BY-BY4\16),AKCNV$(HEX$(I)),BX4/256,BY4/256,7
  100. 1000 SYMBOL(BX-BX4\16,BY+(BY4\16)*I),AKCNV$(HEX$(I)),BX4/256,BY4/256,7
  101. 1010 NEXT:RETURN
  102. 1020 *ERR CLOSE:ER=ERR:'STOP OFF
  103. 1030 IF ER=11 AND (ERL=4100 OR ERL=4110) THEN 1260
  104. 1040 IF ERL=5820 THEN 1200
  105. 1050 FOR RR=0 TO 3:ER(RR)=VIEW(RR):ER(RR+4)=WINDOW(RR):NEXT
  106. 1060 VIEW(40,115)-(295,215):WINDOW(0,0)-(255,100):GOSUB *MO
  107. 1070 BEEP:MOUSE 1,,,1:GET@A(0,0)-(255,100),ERM
  108. 1080 LINE(0,0)-(255,100),PSET,0,BF,7
  109. 1090 LINE(2,2)-(33,33),PSET,0,B
  110. 1100 LINE(2,80)-(60,98),PSET,0,B
  111. 1110 SYMBOL(43,12),"ＥＲＲＯＲ",.75!,1,0
  112. 1120 SYMBOL(148,12),"("+MID$(STR$(ERL),2)+")",.75!,1,0
  113. 1130 SYMBOL(112,11),STR$(ERR),.75!,1,0
  114. 1140 IF ERR=64 THEN SYMBOL(9,81),"実　行",.75!,1,0:LINE(67,80)-(125,98),PSET,0,B:SYMBOL(73,81),"取　消",.75!,1,0:GOTO 1160
  115. 1150 SYMBOL(9,81),"確　認",.75!,1,0
  116. 1160 SYMBOL(127-LEN(LEFT$(ER$(ER),40))*3+(LEN(ER$(ER))>40)*2,35),LEFT$(ER$(ER),40),.75!,1,0
  117. 1170 SYMBOL(5,51),MID$(ER$(ER),41),.75!,1,0
  118. 1180 E$=INKEY$:IF E$=CHR$(13) OR (MOUSE(2,0) AND 42<MOUSE(0) AND MOUSE(0)<100 AND 195<MOUSE(1) AND MOUSE(1)<213) THEN 1200
  119. 1190 IF (E$=CHR$(27) OR (MOUSE(2,0) AND 106<MOUSE(0) AND MOUSE(0)<164 AND 195<MOUSE(1) AND MOUSE(1)<213)) AND ERR=64 THEN 1230 ELSE 1180
  120. 1200 IF ERR=64 THEN KILL A$:ER=74
  121. 1210 IF ERR=67 THEN KILL A$
  122. 1220 ON MUF GOSUB *MI,*MMI
  123. 1230 IF MUSW=1 THEN GOSUB *MUON ELSE GOSUB *MUSTP
  124. 1240 PUT@A(0,0)-(255,100),ERM
  125. 1250 VIEW(ER(0),ER(1))-(ER(2),ER(3)):WINDOW(ER(4),ER(5))-(ER(6),ER(7))
  126. 1260 STOP ON:IF ER=74 THEN ER=0:RESUME ELSE RESUME NEXT
  127. 1270 *ERRM
  128. 1280 ER$(53)="入出力装置に異常が発生しました"
  129. 1290 ER$(55)="ファイルの記述に誤りがあります"
  130. 1300 ER$(63)="指定のファイルが見つかりません"
  131. 1310 ER$(64)="指定のファイルは既に存在しています"
  132. 1320 ER$(67)="ディスクに空き領域がありません"
  133. 1330 ER$(72)="指定されたディスク装置が使用可能な状態になっていません"
  134. 1340 ER$(73)="指定されたディスクは書き込みが禁止されています"
  135. 1350 RETURN
  136. 1360 *ZA INPUT "場所=",A$:A$=RIGHT$("0"+A$,2)
  137. 1370 IF A$="0" THEN RETURN *字
  138. 1380 EX=BX+VAL("&H"+LEFT$(A$,1))*BX4/16
  139. 1390 EY=BY+VAL("&H"+RIGHT$(A$,1))*BY4/16
  140. 1400 RETURN
  141. 1410 *ESC GOSUB *ESCG:V=V+1+(EV-1=V)*EV:V2=-1:GOTO *ESCP
  142. 1420 *ESC2 GOSUB *ESCG:V=V-1-(V=0)*EV:V2=-1:GOTO *ESCP
  143. 1430 *ESCG GET@A(BX,BY)-(BX2,BY2),V,-V*BX4*BY4*(V2=-1)-V2*BX4*(V2>-1):RETURN
  144. 1440 *ESCP PUT@A(BX,BY)-(BX2,BY2),V,,,,,-V*BX4*BY4*(V2=-1)-V2*BX4*(V2>-1)
  145. 1450 SYMBOL(BX-BX4\16,BY-BY4\16),"■",BX4/256,BY4/256,0
  146. 1460 SYMBOL(BX-BX4\16,BY-BY4\16),AKCNV$(MID$(STR$(V+1),2)),BX4/256/(LEN(STR$(V+1))-1),BY4/256,4
  147. 1470 RETURN
  148. 1480 *GSAVE EX=BX2:EY=BY2:GOTO *GSA
  149. 1490 *GFSA PRINT "SAVE 範囲指定(右下) ";:GOSUB *ZA:EX=EX+BX3\16:EY=EY+BY3\16
  150. 1500 *GSA LINE INPUT "SAVE FILE NAME ",A$:IF A$="" OR A$=" " THEN *字
  151. 1510 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  152. 1520 SAVE@ A$,(BX,BY)-(EX,EY):GOTO *字
  153. 1530 *GLOAD LINE INPUT "LOAD FILE NAME ";A$:IF A$="" OR A$=" " THEN *字
  154. 1540 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  155. 1550 OPEN "I",#1,A$:CLOSE:IF ER>0 THEN *字
  156. 1560 OPEN "R",#1,A$:FOR I=0 TO 255:FIELD #1,I AS D$,1 AS B$(I):NEXT
  157. 1570 GET #1:OF=CVI(B$(5)+B$(4)):KOSU=CVI(B$(OF+1)+B$(OF))-1
  158. 1580 FOR I=0 TO KOSU
  159. 1590 TAG=12*I+2+OF:IF TAG>255 THEN GET #1:OF=OF-256:GOTO 1590
  160. 1600 TA=CVI(B$(TAG+1)+B$(TAG))
  161. 1610 IF TA=&H0100 THEN LX=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  162. 1620 IF TA=&H0101 THEN LY=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  163. 1630 IF TA=&H0102 THEN MD=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  164. 1640 NEXT:CLOSE:I=0
  165. 1650 IF MD=4 THEN MODE=0
  166. 1660 IF MD=8 THEN MODE=2
  167. 1670 VIEW(0,0)-(319,239):WINDOW(0,0)-(319,239):SCREEN@MODE
  168. 1680 IF LX>BX4 OR LY>BY4 THEN *GL_A
  169. 1690 IF MD<16 AND MD>2 THEN GOSUB *EDG:LOAD@ A$:EX=0:EY=0:GOTO *変換3
  170. 1700 LOAD@ A$,(BX,BY)
  171. 1710 GOTO *字
  172. 1720 *GL_A CLS:EX=-((VIEW(2)-LX)/2)*(LX-1<VIEW(2))
  173. 1730 EY=-((VIEW(3)-LY)/2)*(LY-1<VIEW(3)):LOAD@ A$,(EX,EY):OSW=1
  174. 1740 EX=MX:EY=MY:MX=MOUSE(0):MY=MOUSE(1)
  175. 1750 IF OSW=1 THEN OSW=0:GOTO 1780
  176. 1760 IF EX=MX AND EY=MY THEN 1790
  177. 1770 LINE(EX,EY)-(EX+BX3,EY+BY3),XOR,4,B
  178. 1780 LINE(MX,MY)-(MX+BX3,MY+BY3),XOR,4,B
  179. 1790 IF MOUSE(2,1) THEN MODE=1:RETURN *S1
  180. 1800 IF MOUSE(2,0)=0 THEN 1740
  181. 1810 LINE(EX,EY)-(EX+BX3,EY+BY3),XOR,4,B
  182. 1820 IF MODE<>1 THEN *変換3
  183. 1830 BX=EX:BY=EY:BX2=BX+BX3:BY2=BY+BY3
  184. 1840 GOSUB *ESCG:RETURN *S1
  185. 1850 *DLOAD LINE INPUT "Load SPRITE FILE NAME ",A$:IF A$="" OR A$=" " THEN *字
  186. 1860 OPEN "I",#1,A$:IF ER=63 THEN *字
  187. 1870 B$=INPUT$(6,1):CLOSE:IF B$<>"SPRITE" THEN *字
  188. 1880 LOAD@ A$,D
  189. 1890 FOR Y=0 TO 7:FOR X=0 TO 7
  190. 1900 PUT@A(BX+X*16,BY+Y*16)-(BX+X*16+15,BY+Y*16+15),D,,,,,257*(X+8*Y)+9
  191. 1910 NEXT X,Y:GOTO *字
  192. 1920 *DSAVE LINE INPUT "Save SPRITE FILE NAME ",A$:IF A$="" OR A$=" " THEN *字
  193. 1930 D(0)=&H5053:D(1)=&H4952:D(2)=&H4554:D(3)=0:D(4)=15
  194. 1940 D(5)=16:D(6)=16:D(7)=64
  195. 1950 FOR Y=0 TO 7:FOR X=0 TO 7
  196. 1960 D((X+Y*8)*257+8)=X+Y*8
  197. 1970 GET@A(BX+X*VZ(6),BY+Y*VZ(7))-(BX+(X+1)*VZ(6)-1,BY+(Y+1)*VZ(7)-1),D,(X+Y*8)*257+9
  198. 1980 NEXT X,Y
  199. 1990 SAVE@ A$,D:GOTO *字
  200. 2000 *DS16 LINE INPUT "SA SPR16 FILE NAME ",A$:IF A$="" OR A$=" " THEN *字
  201. 2010 INPUT "いくつ変換しますか (1-64)",I:IF I<1 THEN *字
  202. 2020 LINE(320,0)-(511,255),PSET,0,BF:I&=VARPTR(D(0))
  203. 2030 GET@A(320,0)-(399,63),D
  204. 2040 FOR X=0 TO 7:GET@A(BX+X*16,BY)-(BX+X*16+15,BY2),B,2048*X:NEXT
  205. 2050 FOR X=0 TO I-1:Z=0
  206. 2060 D(80*X+64)=(M(1,0)\8)*1024+(M(1,1)\8)*32+M(1,2)\8
  207. 2070 FOR EX=0 TO 255
  208. 2080 FOR Y=0 TO Z
  209. 2090 IF D(80*X+64+Y)=B(X*256+EX) THEN B(X*256+EX)=-Y-1
  210. 2100 NEXT
  211. 2110 IF B(X*256+EX)>-1 THEN Z=Z+1:D(80*X+64+Z)=B(X*256+EX):B(X*256+EX)=-Z-1
  212. 2120 NEXT
  213. 2130 IF Z>15 THEN 2180
  214. 2140 FOR Y=0 TO 255 STEP 4
  215. 2150 POKE I&+160*X+(Y\4)*2,(-B(X*256+Y)-1)*16-B(X*256+Y+1)-1,1
  216. 2160 POKE I&+160*X+(Y\4)*2+1,(-B(X*256+Y+2)-1)*16-B(X*256+Y+3)-1,1
  217. 2170 NEXT
  218. 2180 NEXT
  219. 2181 OPEN "A",#1,A$:IF ER>0 THEN CLOSE:GOTO *字
  220. 2182 FOR X=0 TO I-1
  221. 2183 FOR Y=0 TO 79
  222. 2184 FOR Z=0 TO 1
  223. 2185 EX=PEEK(I&+X*160+Y*2+Z,1)\16
  224. 2186 EY=PEEK(I&+X*160+Y*2+Z,1) MOD 16
  225. 2187 PRINT #1,CHR$(EY*16+EX);
  226. 2188 NEXT Z,Y,X
  227. 2189 CLOSE
  228. 2190 RETURN
  229. 2200 *ＭＯＵＳＥ '*************************************************
  230. 2210 *MOUSE M0=MOUSE(2,0):M1=MOUSE(2,1):MX=MOUSE(0):MY=MOUSE(1):I=0
  231. 2220 IF MX>=BX AND MX<=BX2 AND MY>=BY AND MY<=BY2 THEN I=1
  232. 2230 IF I=1 AND (MNO=1 OR MNO=2) THEN *TEC
  233. 2240 *MP IF M0+M1=0 THEN RETURN
  234. 2250 IF MX>=WX AND MX<=WX+XN AND MY>=WY AND MY<=WY+YN THEN *BOT
  235. 2260 IF I=1 THEN *TE
  236. 2270 IF MX>0 AND MX<64 THEN I=2
  237. 2280 IF MX>=XK AND MX<=XK2 AND MY>=YK AND MY<=YK2 THEN *MMM
  238. 2290 IF MX<=32 AND MY>=24 AND ((MY-24)\10)*2+MX\16<KI+1 THEN *MKINO
  239. 2300 IF I=2 AND MY>=185 AND MY<=196 THEN *MPEN
  240. 2310 IF MX>0 AND MX<129 AND MY>200 AND MY<219 THEN *MCHCOL
  241. 2320 IF MX>129 AND MX<138 AND MY>200 AND MY<219 THEN *MCHCOL2
  242. 2330 IF MX<BX-BX4/32 AND MX>BX-BX4/16 AND MY>=BY AND MY<BY2+1 THEN *MESC
  243. 2340 IF MX<BX AND MX>BX-BX4/16 AND MY<BY AND MY>BY-BY4/16 THEN I=3
  244. 2350 IF M0 AND I=3 THEN *ESC
  245. 2360 IF M1 AND I=3 THEN *ESC2
  246. 2370 IF MY<20 THEN *MKEY
  247. 2380 RETURN
  248. 2390 *MCHCOL
  249. 2400 MC=(MY-201)\6:I=M(2,MC):M(2,MC)=((MX-1)\4)*8
  250. 2410 IF I=M(2,MC) THEN RETURN
  251. 2420 LINE(130,201)-(136,218),PSET,[M(2,0),M(2,1),M(2,2)],BF
  252. 2430 LINE(I/2+1,202+MC*6)-(I/2+4,205+MC*6),XOR,7,B
  253. 2440 LINE(M(2,MC)/2+1,202+MC*6)-(M(2,MC)/2+4,205+MC*6),XOR,7,B
  254. 2450 FOR Y=0 TO 2:EY=202+Y*6
  255. 2460 LINE(M(2,Y)/2+1,EY)-(M(2,Y)/2+4,EY+3),XOR,7,B
  256. 2470 LINE(1,EY+2)-(128,EY+4),AND,[-255*(Y=0),-255*(Y=1),-255*(Y=2)],BF
  257. 2480 LINE(1,EY+2)-(128,EY+4),OR,[-M(2,0)*(Y>0),-M(2,1)*(Y<>1),-M(2,2)*(Y<2)],BF
  258. 2490 LINE(M(2,Y)/2+1,EY)-(M(2,Y)/2+4,EY+3),XOR,7,B:NEXT:RETURN
  259. 2500 *MCHCOL2
  260. 2510 IF M0 THEN M(0,2)=M(2,2):M(0,1)=M(2,1):M(0,0)=M(2,0)
  261. 2520 IF M1 THEN M(1,2)=M(2,2):M(1,1)=M(2,1):M(1,0)=M(2,0)
  262. 2530 *MCHN
  263. 2540 IF M0 THEN X=140:Y=0:GOSUB *MCS
  264. 2550 IF M1 THEN X=150:Y=1:GOSUB *MCS
  265. 2560 RETURN
  266. 2570 *MCS LINE(X+1,201)-(X+7,218),PSET,[M(Y,0),M(Y,1),M(Y,2)],BF:RETURN
  267. 2580 *MMM ON MKNO GOSUB *MPOINT,*MLINE,*MLINE,*MLINE,*MMARU,*MMARU,*MARU1,*MARU1,*TEN,*TEN,*MCOPY,*MCOPY,*MPAINT
  268. 2590 GOTO *MOUSE
  269. 2600 *R GOSUB *WO:GOSUB *拡大:RETURN
  270. 2610 *MPOINT
  271. 2620 MXP=(MX-XK)\XB:MXW=XB*MXP+XK:MYP=(MY-YK)\YB:MYW=YB*MYP+YK:X=M0+1
  272. 2630 LINE(MXW,MYW)-(MXW+XB2,MYW+YB2),PSET,[M(X,0),M(X,1),M(X,2)],BF
  273. 2640 PSET(WX+MXP,WY+MYP),[M(X,0),M(X,1),M(X,2)]
  274. 2650 RETURN
  275. 2660 *MLINE MX1=MX:MY1=MY:GOSUB *MI
  276. 2670 EX=MX1:EY=MY1:MX=MOUSE(0):MY=MOUSE(1)
  277. 2680 IF MKNO=2 THEN 2750
  278. 2690 IF MX<EX THEN SWAP EX,MX
  279. 2700 IF MY<EY THEN SWAP EY,MY
  280. 2710 MX20=FNMX(EX):MY20=FNMY(EY)
  281. 2720 MX21=FNMX(MX)+XB:MY21=FNMY(MY)+YB
  282. 2730 LINE(MX20,MY20)-(MX21,MY21),XOR,4,B
  283. 2740 LINE(MX20,MY20)-(MX21,MY21),XOR,4,B:GOTO 2790
  284. 2750 MX20=FNMX(MX1)+XB/2:MY20=FNMY(MY1)+YB/2
  285. 2760 MX21=FNMX(MX)+XB/2:MY21=FNMY(MY)+YB/2
  286. 2770 LINE(MX20,MY20)-(MX21,MY21),XOR,4
  287. 2780 LINE(MX20,MY20)-(MX21,MY21),XOR,4
  288. 2790 IF MOUSE(2,0) OR MOUSE(2,1) THEN 2670
  289. 2800 GOSUB *MO
  290. 2810 MC=M0+1:ON MKNO-1 GOTO 2820,2830,2840
  291. 2820 LINE(FNSX(MX1),FNSY(MY1))-(FNSX(MX),FNSY(MY)),PSET,[M(MC,0),M(MC,1),M(MC,2)]:GOTO *R
  292. 2830 LINE(FNSX(EX),FNSY(EY))-(FNSX(MX),FNSY(MY)),PSET,[M(MC,0),M(MC,1),M(MC,2)],B:GOTO *R
  293. 2840 LINE(FNSX(EX),FNSY(EY))-(FNSX(MX),FNSY(MY)),PSET,[M(MC,0),M(MC,1),M(MC,2)],BF:GOTO *R
  294. 2850 *MMARU MX1=MX:MY1=MY
  295. 2860 GOSUB *MI:GOSUB *WI2
  296. 2870 MX=MOUSE(0):MY=MOUSE(1):MR=SQR((MX-MX1)*(MX-MX1)+(MY-MY1)*(MY-MY1)*XB/YB)
  297. 2880 CIRCLE(MX1,MY1),MR,4,YB/XB,,,N,XOR:CIRCLE(MX1,MY1),MR,4,YB/XB,,,N,XOR
  298. 2890 IF MOUSE(2,0) OR MOUSE(2,1) THEN 2870
  299. 2900 GOSUB *MO:GOSUB *WO
  300. 2910 MC=-M1:GOSUB *WI
  301. 2920 CIRCLE(FNSX(MX1),FNSY(MY1)),MR/XB,[M(MC,0),M(MC,1),M(MC,2)],1,,,N,PSET
  302. 2930 IF MKNO=6 THEN CIRCLE(FNSX(MX1),FNSY(MY1)),MR/XB,[M(MC,0),M(MC,1),M(MC,2)],1,,,F,PSET
  303. 2940 GOTO *R
  304. 2950 *MARU1 MX1=MX:MY1=MY
  305. 2960 GOSUB *MI:GOSUB *WI2
  306. 2970 MX=MOUSE(0):MY=MOUSE(1)
  307. 2980 MR=ABS(MX-MX1):IF MR<1 THEN 2970
  308. 2990 GMH=ABS((MY-MY1)/MR):IF GMH<.01! THEN 2970
  309. 3000 CIRCLE(MX1,MY1),MR,4,GMH,,,N,XOR:CIRCLE(MX1,MY1),MR,4,GMH,,,N,XOR
  310. 3010 IF MOUSE(2,0) OR MOUSE(2,1) THEN 2970
  311. 3020 GOSUB *MO:GOSUB *WO
  312. 3030 GOSUB *WI
  313. 3040 CIRCLE(FNSX(MX1),FNSY(MY1)),MR/XB,[M(MC,0),M(MC,1),M(MC,2)],GMH*XB/YB,,,N,PSET
  314. 3050 IF MKNO=8 THEN CIRCLE(FNSX(MX1),FNSY(MY1)),MR/XB,[M(MC,0),M(MC,1),M(MC,2)],GMH*XB/YB,,,F,PSET
  315. 3060 GOTO *R
  316. 3070 *TEN GOSUB *MI
  317. 3080 EX=MX:EY=MY:X=MOUSE(0):Y=MOUSE(1)
  318. 3090 IF X<EX THEN SWAP X,EX
  319. 3100 IF Y<EY THEN SWAP Y,EY
  320. 3110 LINE(FNMX(EX),FNMY(EY))-(FNMX(X)+XB,FNMY(Y)+YB),XOR,7,B
  321. 3120 LINE(FNMX(EX),FNMY(EY))-(FNMX(X)+XB,FNMY(Y)+YB),XOR,7,B
  322. 3130 IF MOUSE(2,0) THEN 3080
  323. 3140 X=FNSX(X):Y=FNSY(Y)
  324. 3150 EX=FNSX(EX):EY=FNSY(EY)
  325. 3160 GOSUB *MO
  326. 3170 IF MKNO=9 THEN *UD ELSE *LR
  327. 3180 *MCOPY GOSUB *MI:MX1=MX:MY1=MY:GOSUB *MUSTP
  328. 3190 MX=MOUSE(0):MY=MOUSE(1)
  329. 3200 MXS=MX1:MXL=MX:IF MXS>MXL THEN SWAP MXS,MXL
  330. 3210 MYS=MY1:MYL=MY:IF MYS>MYL THEN SWAP MYS,MYL
  331. 3220 LINE(FNMX(MXS),FNMY(MYS))-(FNMX(MXL)+XB,FNMY(MYL)+YB),XOR,4,B
  332. 3230 LINE(FNMX(MXS),FNMY(MYS))-(FNMX(MXL)+XB,FNMY(MYL)+YB),XOR,4,B
  333. 3240 IF MOUSE(2,0) THEN 3190
  334. 3250 LINE(FNMX(MXS),FNMY(MYS))-(FNMX(MXL)+XB,FNMY(MYL)+YB),XOR,4,B
  335. 3260 MX20=FNSX(MXS):MY20=FNSY(MYS):MX21=FNSX(MXL):MY21=FNSY(MYL)
  336. 3270 GOSUB *MR:IF MOUSE(2,1)=-1 THEN *MCOPYEXIT
  337. 3280 LINE(FNMX(MXS),FNMY(MYS))-(FNMX(MXL)+XB,FNMY(MYL)+YB),XOR,4,B
  338. 3290 MOUSE 1,MXL,MYL:MUSW=0
  339. 3300 GET@A(MX20,MY20)-(MX21,MY21),B
  340. 3310 MX5=ABS(FNMX(MXL)-FNMX(MXS)):MY5=ABS(FNMY(MYL)-FNMY(MYS))
  341. 3320 MOUSE 4,XK+MX5,YK+MY5,XK2,YK2
  342. 3330 MX=MOUSE(0):MY=MOUSE(1)
  343. 3340 MXS=MX-MX5:MXL=MX:MYS=MY-MY5:MYL=MY
  344. 3350 MX10=FNMX(MXS):MY10=FNMY(MYS):MX11=FNMX(MXL)+XB:MY11=FNMY(MYL)+YB
  345. 3360 LINE(MX10,MY10)-(MX11,MY11),XOR,4,B
  346. 3370 LINE(MX10,MY10)-(MX11,MY11),XOR,4,B
  347. 3380 IF MOUSE(2,0) THEN 3330
  348. 3390 LINE(MX10,MY10)-(MX11,MY11),XOR,4,B
  349. 3400 GOSUB *MR:IF MOUSE(2,1)=-1 THEN *MCOPYEXIT
  350. 3410 GOSUB *MO
  351. 3420 X=FNSX(MX10+1):Y=FNSY(MY10)
  352. 3430 IF MKNO=12 THEN LINE(MX20,MY20)-(MX21,MY21),PSET,0,BF
  353. 3440 IF MOUSE(2,0) THEN PUT@A(X,Y)-(X-MX20+MX21,Y-MY20+MY21),B
  354. 3450 *MCOPYEXIT IF MOUSE(2,0)=0 AND MOUSE(2,1)=0 THEN GOSUB *MUON:GOSUB *MO:GOTO *R ELSE *MCOPYEXIT
  355. 3460 *MPAINT X=FNSX(MX):Y=FNSY(MY):GOSUB *WI
  356. 3470 PAINT@(X,Y),[ M(MC,0),M(MC,1),M(MC,2)]:GOSUB *WO:GOTO 2600
  357. 3480 *MI MUF=1:MOUSE 4,XK,YK,XK2,YK2:RETURN
  358. 3490 *MMI MUF=2:MOUSE 4,BX,BY,BX2,BY2:RETURN
  359. 3500 *MO MUF=0:MOUSE 4,0,0,319,239:RETURN
  360. 3510 *WI WINDOW(WX,WY)-(WX+XN,WY+YN):VIEW(WX,WY)-(WX+XN,WY+YN):RETURN
  361. 3520 *WI2 WINDOW(XK,YK)-(XK2,YK2):VIEW(XK,YK)-(XK2,YK2):RETURN
  362. 3530 *WI3 WINDOW(BX,BY)-(BX2,BY2):VIEW(BX,BY)-(BX2,BY2):RETURN
  363. 3540 *WO WINDOW(0,0)-(511,255):VIEW(0,0)-(511,255):RETURN
  364. 3550 *TE ON MNO GOTO 3560,3600,*MGET,*MPUT,*楕円,*TILCH,*NEKO,*FANT,*MPEN2
  365. 3560 GP(L)=V:GP2(L)=V2:GPX(L)=EX-BX:GPY(L)=EY-BY
  366. 3570 IF M0 THEN GET@A(WX,WY)-(WX+XN,WY+YN),B:PUT@A(EX,EY)-(EX+XN,EY+YN),B
  367. 3580 IF M1 THEN GET@A(EX,EY)-(EX+XN,EY+YN),B:PUT@A(WX,WY)-(WX+XN,WY+YN),B:GOSUB *拡大
  368. 3590 LOCATE 11,5:PRINT USING "編集元 Page###    x###  y###";GP(L)+1,GPX(L),GPY(L):LOCATE 0,24:GOTO *MOUSE
  369. 3600 IF M0 THEN GET@A(WX,WY)-(WX+XN,WY+YN),B:PUT@A(EX,EY)-(EX+XN,EY+YN),B
  370. 3610 IF M1 THEN GET@A(EX,EY)-(EX+XN,EY+YN),B:GET@A(WX,WY)-(WX+XN,WY+YN),D:PUT@A(WX,WY)-(WX+XN,WY+YN),B:PUT@A(WX,WY)-(WX+XN,WY+YN),D,MATTE,,,[M(1,0),M(1,1),M(1,2)]:GOSUB *拡大
  371. 3620 GOTO *MOUSE
  372. 3630 *MKEY X=MX\20
  373. 3640 IF X=0 THEN *MODES
  374. 3650 IF X=12 THEN *MDO
  375. 3660 IF X=13 THEN *率
  376. 3670 IF X=14 THEN *MCDP
  377. 3680 IF X=15 THEN *END
  378. 3690 RETURN
  379. 3700 *MCDP IF M0 THEN CD PLAY
  380. 3710 IF M1 THEN CD STOP
  381. 3720 RETURN
  382. 3730 *NEKO GOSUB *ESCG:Y2=(BY+BY2)/2:GOSUB *MMI:IF V2=-1 THEN V2=V*BY4
  383. 3740 MOUSE 1,(BX2+BX)/2,Y2,0
  384. 3750 V2=V2+MOUSE(1)-Y2:M0=MOUSE(2,0)
  385. 3760 IF V2<0 THEN V2=0
  386. 3770 IF V2>(V&\BX4)-BY4 THEN V2=(V&\BX4)-BY4
  387. 3780 PUT@A(BX,BY)-(BX2,BY2),V,,,,,V2*BX4
  388. 3790 IF M0 THEN 3750
  389. 3800 GOSUB *MUON:GOSUB *MO:RETURN
  390. 3810 *MPEN CIRCLE(MPEN*8+4,192),MPEN,7,1,,,F,PSET:MPEN=(MX-1)\8
  391. 3820 *MPE CIRCLE(MPEN*8+4,192),MPEN,2,1,,,F,PSET
  392. 3830 GET@A(MPEN*8-4,185)-(MPEN*8+11,200),B
  393. 3840 PUT@A(404,240)-(419,255),B
  394. 3850 GET@(397,232)-(428,255),P,2:RETURN
  395. 3860 *MPEN2 GOSUB *WI3:GOSUB *PEI
  396. 3870 M0=MOUSE(2,0):M1=MOUSE(2,1):MC=-M1
  397. 3880 IF M0=0 AND M1=0 THEN 3910
  398. 3890 X=MX:Y=MY:MX=MOUSE(0):MY=MOUSE(1):LINE(X,Y)-(MX,MY),PSET,[M(MC,0),M(MC,1),M(MC,2)]
  399. 3900 IF MX>=BX AND MY>=BY AND M0 OR M1 THEN 3870
  400. 3910 GOSUB *WO:GOTO *MOUSE
  401. 3920 *楕円 GOSUB *WI3:GOSUB *MMI:GOSUB *PEI:GET@A(BX,BY)-(BX2,BY2),B
  402. 3930 IF MOUSE(2,0) THEN X=MOUSE(4,0):Y=MOUSE(5,0):PSET(X,Y),7,XOR ELSE 3930
  403. 3940 IF MOUSE(2,0) THEN 3940
  404. 3950 IF MOUSE(2,0) THEN EX=MOUSE(4,0):EY=MOUSE(5,0):PSET(EX,EY),7,XOR ELSE 3950
  405. 3960 IF MOUSE(2,0) THEN 3960
  406. 3970 IF MOUSE(2,0) THEN GX3=MOUSE(4,0):GY3=MOUSE(5,0) ELSE 3970
  407. 3980 IF MOUSE (2,0) THEN 3980
  408. 3990 PSET(X,Y),7,XOR:PSET(EX,EY),7,XOR
  409. 4000 GOSUB *MUSTP
  410. 4010 GSQR=SQR((EX-X)*(EX-X)+(EY-Y)*(EY-Y))
  411. 4020 IF GSQR=0 THEN PSET(X,Y),[M(0,0),M(0,1),M(0,2)]:GOTO 4300
  412. 4030 GCOS=(EX-X)/GSQR:GSIN=(EY-Y)/GSQR
  413. 4040 GX4=(X+EX)/2:GY4=(Y+EY)/2
  414. 4050 X2=EX-GX4:Y2=EY-GY4
  415. 4060 X3=GX3-GX4:Y3=GY3-GY4
  416. 4070 EX2=X2*GCOS+Y2*GSIN
  417. 4080 EX3=X3*GCOS+Y3*GSIN:EY3=-X3*GSIN+Y3*GCOS
  418. 4090 GA=ABS(EX2):GL=EX3:GM=EY3:IF GA=GL THEN ER=11:GOTO 4120
  419. 4100 GB=ABS(GA*GM/SQR(ABS(GA*GA-GL*GL)))
  420. 4110 GAA=(GSIN/GA)^2+(GCOS/GB)^2
  421. 4120 IF ER=11 THEN ER=0:LINE(X,Y)-(EX,EY),PSET,[M(0,0),M(0,1),M(0,2)]:GOTO 4300
  422. 4130 GBB=2*GSIN*GCOS/GA/GA-2*GSIN*GCOS/GB/GB
  423. 4140 GCC=(GCOS/GA)^2+(GSIN/GB)^2
  424. 4150 GX=0:GYY=0
  425. 4160 GV=(GBB*GX)^2-4*GAA*(GCC*GX*GX-1)
  426. 4170 IF GV<0 THEN 4220 ELSE GW=SQR(GV)
  427. 4180 PSET(GX+GX4,(-GBB*GX+GW)/(2*GAA)+GY4),[M(0,0),M(0,1),M(0,2)]
  428. 4190 PSET(GX+GX4,(-GBB*GX-GW)/(2*GAA)+GY4),[M(0,0),M(0,1),M(0,2)]
  429. 4200 PSET(-GX+GX4,(GBB*GX+GW)/(2*GAA)+GY4),[M(0,0),M(0,1),M(0,2)]
  430. 4210 PSET(-GX+GX4,(GBB*GX-GW)/(2*GAA)+GY4),[M(0,0),M(0,1),M(0,2)]
  431. 4220 GVV=(GBB*GYY)^2-4*GCC*(GAA*GYY*GYY-1)
  432. 4230 IF GVV<0 THEN 4280 ELSE GW=SQR(GVV)
  433. 4240 PSET((-GBB*GYY+GW)/(2*GCC)+GX4,GYY+GY4),[M(0,0),M(0,1),M(0,2)]
  434. 4250 PSET((-GBB*GYY-GW)/(2*GCC)+GX4,GYY+GY4),[M(0,0),M(0,1),M(0,2)]
  435. 4260 PSET((GBB*GYY+GW)/(2*GCC)+GX4,-GYY+GY4),[M(0,0),M(0,1),M(0,2)]
  436. 4270 PSET((GBB*GYY-GW)/(2*GCC)+GX4,-GYY+GY4),[M(0,0),M(0,1),M(0,2)]
  437. 4280 GYY=GYY+1:GX=GX+1
  438. 4290 IF GV<0 AND GVV<0 ELSE 4160
  439. 4300 GOSUB *MO:GOSUB *WO:GOSUB *MUON:GOTO *MOUSE
  440. 4310 *MGET GOSUB *MMI:MX1=MX:MY1=MY
  441. 4320 MX=MOUSE(0):MXS=MX1:MXL=MX:IF MXS>MXL THEN SWAP MXS,MXL
  442. 4330 MY=MOUSE(1):MYS=MY1:MYL=MY:IF MYS>MYL THEN SWAP MYS,MYL
  443. 4340 GOSUB *MGP:GOSUB *MGP
  444. 4350 IF MOUSE(2,0) THEN 4320
  445. 4360 GOSUB *MGP
  446. 4370 GOSUB *MR:IF MOUSE(2,1) THEN GOSUB *MGP:GOTO *MGETEXIT
  447. 4380 GOSUB *MGP
  448. 4390 GET@A(MXS,MYS)-(MXL,MYL),VZ
  449. 4400 MX55=ABS(MXL-MXS)+1:MY55=ABS(MYL-MYS)+1
  450. 4410 IF MOUSE(2,0) THEN 4410
  451. 4420 GOTO *MGETEXIT
  452. 4430 *MGP LINE(MXS,MYS)-(MXL,MYL),XOR,4,B:RETURN
  453. 4440 *MPUT IF MOUSE(2,1) THEN *MRE
  454. 4450 GOSUB *MMI:MX1=MX:MY1=MY
  455. 4460 MOUSE 1,MX+MX55+(MX+MX55-319)*(MX+MX55>319),MY+MY55+(MY+MY55-239)*(MY+MY55>239),1:MUSW=1
  456. 4470 MX=MOUSE(0):MXS=MX1:MXL=MX:IF MXL<MXS THEN SWAP MXL,MXS
  457. 4480 MY=MOUSE(1):MYS=MY1:MYL=MY:IF MYL<MYS THEN SWAP MYL,MYS
  458. 4490 GOSUB *MGP:GOSUB *MGP
  459. 4500 IF MOUSE(2,0) THEN 4470
  460. 4510 GOSUB *MGP
  461. 4520 GOSUB *MR
  462. 4530 IF MOUSE(2,1) THEN GOSUB *MGP:GOSUB *MRE:GOTO *MOUSE
  463. 4540 GOSUB *MGP
  464. 4550 MX65=ABS(MXL-MXS)+1:MY65=ABS(MYL-MYS)+1
  465. 4560 PUT@A(MXS,MYS)-(MXS+MX55-1,MYS+MY55-1),VZ,,MX65/MX55,MY65/MY55
  466. 4570 IF MOUSE(2,0) THEN 4570
  467. 4580 MOUSE 1,MX1,MY1,1:MUSW=1
  468. 4590 *MGETEXIT GOSUB *MO:GOTO *MOUSE
  469. 4600 *MKINO I=((MY-24)\10)*2+MX\16+1
  470. 4610 IF A(I-1)=0 THEN 4670
  471. 4620 IF A(I-1)=2 THEN 4660
  472. 4630 Z=MNO+14:GOSUB *MKCH:MNO=I-14
  473. 4640 IF I=15 AND M1 THEN GOSUB *TEB
  474. 4650 GOTO 4680
  475. 4660 IF I=14 THEN *SPOIT
  476. 4670 Z=MKNO:GOSUB *MKCH:MKNO=I
  477. 4680 *MJ Z=I:GOSUB *MKCH:GOTO *MOUSE
  478. 4690 *MKCH X=((Z-1) MOD 2)*16+1:Y=((Z+1)\2)*10+15:LINE(X,Y)-STEP(15,9),XOR,7,BF:RETURN
  479. 4700 *MODES GOSUB *ESCG:GOSUB *EDG:SMODE=4-SMODE
  480. 4710 IF SMODE=3 THEN SPRITE ON ELSE SPRITE OFF
  481. 4720 RETURN
  482. 4730 *TEB SYMBOL(8,101),RIGHT$(STR$(EG),2),.5!,.25!,7:IF EG=1 THEN EG=128
  483. 4740 EG=EG/2:SYMBOL(8,101),RIGHT$(STR$(EG),2),.5!,.25!,0:GOTO *MRE
  484. 4750 *TEC
  485. 4760 EX=BX+((MOUSE(0)-BX-(XN2-EG)/2)\(BX4\(128/EG)))*(BX4\(128/EG))
  486. 4770 EY=BY+((MOUSE(1)-BY-(YN2-EG)/2)\(BY4\(128/EG)))*(BY4\(128/EG))
  487. 4780 IF EX>BX2-XN THEN EX=BX2-XN
  488. 4790 IF EY>BY2-YN THEN EY=BY2-YN
  489. 4800 IF EX<BX THEN EX=BX
  490. 4810 IF EY<BY THEN EY=BY
  491. 4820 LINE(EX,EY)-(EX+XN,EY+YN),XOR,[128,128,128],B
  492. 4830 LINE(EX,EY)-(EX+XN,EY+YN),XOR,[128,128,128],B
  493. 4840 GOTO *MP
  494. 4850 *MRE GOSUB *WO:GOSUB *MO
  495. 4860 *MD IF MOUSE(2,0) OR MOUSE(2,1) THEN *MD ELSE RETURN
  496. 4870 *MR IF MOUSE(2,0) OR MOUSE(2,1) THEN RETURN ELSE *MR
  497. 4880 *BOT X=MX-WX:Y=MOUSE(1)-WY:GOSUB *EDG:Z=6
  498. 4890 LINE(MX-X,MY-Y)-(MX+XN-X,MY+YN-Y),XOR,Z,B
  499. 4900 LINE(MX-X,MY-Y)-(MX+XN-X,MY+YN-Y),XOR,Z,B
  500. 4910 IF MOUSE(2,0) THEN Z=6:MX=MOUSE(0):MY=MOUSE(1):GOTO 4890
  501. 4920 IF MOUSE(2,1) THEN Z=1:MX=MOUSE(0):MY=MOUSE(1):GOTO 4890
  502. 4930 WX=MX-X:WY=MY-Y
  503. 4940 IF Z=6 THEN GOSUB *EDP
  504. 4950 GOTO *MOUSE
  505. 4960 *SPOIT Z=MNO+14:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH:Z=I:GOSUB *MKCH
  506. 4970 GOSUB *MD
  507. 4980 M0=MOUSE(2,0):M1=MOUSE(2,1):IF M0 OR M1 ELSE 4980
  508. 4990 GET@A(MOUSE(0),MOUSE(1))-(MOUSE(0),MOUSE(1)),B:MC=-M1:B(0)=B(0) AND 32767
  509. 5000 M(MC,0)=(B(0)\1024)*8:M(MC,1)=B(0)\4 AND 248:M(MC,2)=B(0)*8 AND 248
  510. 5010 GOSUB *MCHN:Z=MNO+14:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH
  511. 5020 GOSUB *MD:GOTO *MJ
  512. 5030 *TILCH GET@A(BX,BY)-(BX2,BY2),B
  513. 5040 LINE(BX,BY)-(BX2,BY2),PSET,[M(0,0),M(0,1),M(0,2)],BF
  514. 5050 PUT@A(BX,BY)-(BX2,BY2),B,MATTE,,,[M(1,0),M(1,1),M(1,2)]:GOSUB *MUON:RETURN
  515. 5060 *PEI IF MPEN=0 THEN DEF PEN 0,1:RETURN
  516. 5070 DEF PEN 1,P:RETURN
  517. 5080 *MESC GOSUB *ESCG
  518. 5090 V2=(MY-BY)*(V&-16384)/16384:PUT@A(BX,BY)-(BX2,BY2),V,,,,,V2*BX4
  519. 5100 SYMBOL(BX-BX4\16,BY-BY4\16),"■",BX4/256,BY4/256,0:RETURN
  520. 5110 *MDO GOSUB *ESCG:V=GP(L):V2=GP2(L):GOSUB *ESCP
  521. 5120 EX=GPX(L)+BX:EY=GPY(L)+BY:GOTO 3570
  522. 5130 '********************************************************************
  523. 5140 *反転 LINE(WX,WY)-(WX+XN,WY+YN),XOR,7,BF:GOTO *拡大
  524. 5150 *B反転 LINE(BX,BY)-(BX2,BY2),XOR,7,BF:RETURN
  525. 5160 *WQU X=1:GOTO *WQ
  526. 5170 *WQA X=0
  527. 5180 *WQ Y=(1-X)*BY4\2
  528. 5190 GET@A(BX,BY)-(BX2,BY2),B
  529. 5200 GET@A(BX+X,BY+1-X)-(BX2+X,BY2+1-X),D
  530. 5210 PUT@A(BX,BY)-(BX2,BY2),B,,1/(1+X),1/(2-X)
  531. 5220 PUT@A(BX+X*BX4\2,BY+Y)-(BX2+(BX4\2)*X,BY2+Y),D,,1/(1+X),1/(2-X)
  532. 5230 RETURN
  533. 5240 *SUD X=WX:Y=WY:EX=X+XN:EY=Y+YN:GOTO *UD
  534. 5250 *BUD X=BX:Y=BY:EX=BX2:EY=BY2
  535. 5260 *UD IF EY<Y THEN SWAP EY,Y
  536. 5270 Z=EY-Y:FOR I=0 TO Z STEP 2:I&=I-((Z MOD 2)=0)*(I>Z\2)
  537. 5280 GET@A(X,Y+I&)-(EX,Y+I&),B:GET@A(X,EY-I&)-(EX,EY-I&),D
  538. 5290 PUT@A(X,Y+I&)-(EX,Y+I&),D:PUT@A(X,EY-I&)-(EX,EY-I&),B
  539. 5300 NEXT:GOTO *拡大
  540. 5310 *SLR X=WX:Y=WY:EX=X+XN:EY=Y+YN:GOTO *LR
  541. 5320 *BLR X=BX:Y=BY:EX=BX2:EY=BY2
  542. 5330 *LR IF EX<X THEN SWAP EX,X
  543. 5340 Z=EX-X:FOR I=0 TO Z STEP 2:I&=I-((Z MOD 2)=0)*(I>Z\2)
  544. 5350 GET@A(X+I&,Y)-(X+I&,EY),B:GET@A(EX-I&,Y)-(EX-I&,EY),D
  545. 5360 PUT@A(X+I&,Y)-(X+I&,EY),D:PUT@A(EX-I&,Y)-(EX-I&,EY),B
  546. 5370 NEXT:GOTO *拡大
  547. 5380 *CLS FOR I=0 TO XB*XN2-1 STEP 2
  548. 5390 LINE(XK+I,YK+I)-(XK+XB*XN2-I-1,YK+YB*YN2-I-1),PSET,0,B
  549. 5400 LINE(WX+I\XB,WY+I\YB)-(WX+XN2-I\XB-1,WY+YN2-I\YB-1),PSET,0,B
  550. 5410 NEXT:RETURN
  551. 5420 *BCLS FOR I=0 TO BY3 STEP 2
  552. 5430 LINE(BX,BY+I)-(BX2,BY+I),PSET,0
  553. 5440 LINE(BX,BY2-I)-(BX2,BY2-I),PSET,0
  554. 5450 NEXT:RETURN
  555. 5460 *SROLL EX=WX:EY=WY:X=XN:Y=YN:GOTO *ROLL
  556. 5470 *BROLL EX=BX:EY=BY:X=BX3:Y=BY3
  557. 5480 *ROLL A$=INKEY$:IF A$="" AND MOUSE(2,0)=0 AND MOUSE(2,1)=0 THEN 5480
  558. 5490 IF INSTR("2468"+CHR$(28,29,30,31),A$)=0 OR MOUSE(2,0) OR MOUSE(2,1) THEN *拡大
  559. 5500 D6=-(A$=CHR$(28))-(A$="6")*16-(A$=CHR$(29))*X-(A$="4")*(X-15)
  560. 5510 D8=-(A$=CHR$(30))-(A$="8")*16-(A$=CHR$(31))*Y-(A$="2")*(Y-15)
  561. 5520 GET@A(EX,EY+D8)-(EX+X-D6,EY+Y),B
  562. 5530 GET@A(EX-(D6>0)*(X+1)-D6,EY)-(EX+X,EY+Y+(D8>0)*(Y+1)+D8),D
  563. 5540 PUT@A(EX,EY-(D8>0)*(Y+1)-D8)-(EX+X+(D6>0)*(X+1)+D6,EY+Y),D
  564. 5550 PUT@A(EX+D6,EY)-(EX+X,EY+Y-D8),B
  565. 5560 GOTO 5480
  566. 5570 *S回転 EX=WX:EY=WY:X=WX+XN:Y=WY+YN:Z=XN:YY=YN:I=0:GOTO *回転
  567. 5580 *B回転 EX=BX:EY=BY:X=BX2:Y=BY2:Z=BX3:YY=BY3:I=1
  568. 5590 *回転 FOR I=EX TO X:GET@A(I,EY)-(I,Y),B,(Z+EX-I)*(YY+1):NEXT
  569. 5600 PUT@A(EX,EY)-(X,Y),B
  570. 5610 IF I=1 THEN RETURN ELSE *拡大
  571. 5620 *S右回転 EX=WX:EY=WY:X=WX+XN:Y=WY+YN:Z=XN:YY=YN:I=0:GOTO *右回転
  572. 5630 *B右回転 EX=BX:EY=BY:X=BX2:Y=BY2:Z=BX3:YY=BY3:I=1
  573. 5640 *右回転 GET@A(EX,EY)-(X,Y),B
  574. 5650 FOR I=EX TO X
  575. 5660 PUT@A(I,EY)-(I,Y),B,,,,,(Z+EX-I)*(YY+1):NEXT
  576. 5670 IF I=1 THEN RETURN ELSE *拡大
  577. 5680 *変換 GOSUB *ESCG
  578. 5690 SIMPOSE 1
  579. 5700 SINPUT:IF MOUSE(2,1) THEN RETURN *S1
  580. 5710 GOSUB *MD
  581. 5720 A$=INKEY$
  582. 5730 IF A$=CHR$(13) OR MOUSE(2,1) THEN GOSUB *MD:GOTO 5700
  583. 5740 IF A$="" AND MOUSE(2,0)=0 THEN 5720
  584. 5750 IF MOUSE(2,0) THEN 5750 ELSE OSW=1:GOTO 1740
  585. 5760 *変換3 GET@A(EX,EY)-(EX+BX3,EY+BY3),B:SCREEN@1:CLS:GET@A(0,0)-(127,127),D
  586. 5770 FOR T=0 TO 2:FOR I=5-(T=2) TO 7:A=2^I+31
  587. 5780 X=-A*(T=0):Y=-A*(T=1):Z=-(A+32)*(T=2):SCREEN@MODE:PUT@A(BX,BY)-(BX2,BY2),B
  588. 5790 LINE(BX,BY)-(BX2,BY2),AND,[X,Y,Z],BF:GET@(BX,BY)-(BX2,BY2),D
  589. 5800 SCREEN@1:VIEW(0,0)-(319,239):GOSUB *ESCP
  590. 5810 PUT@(BX,BY)-(BX2,BY2),D,OR,[X,Y,Z]:GOSUB *ESCG:NEXT I,T
  591. 5820 MODE=1:RETURN *S1
  592. 5830 *B拡大 GOSUB *ZA
  593. 5840 GET@A(EX,EY)-(EX+BX3\2,EY+BY3\2),B
  594. 5850 PUT@A(BX,BY)-(BX+BX3\2,BY+BY3\2),B,,2,2
  595. 5860 GOTO *字
  596. 5870 *率 EGX(L)=WX:EGY(L)=WY:GOSUB *EDG:XN2=XN2*2:IF XN2=128 THEN XN2=4
  597. 5880 YN2=YN2*2:IF YN2=128 THEN YN2=4
  598. 5890 L=L+1+(L=4)*5:GOSUB *MODE:GOSUB *EDP:GOSUB *拡大:RETURN
  599. 5900 *EDG GET@A(WX,WY)-(WX+XN,WY+YN),VA,EM(L):RETURN
  600. 5910 *EDP PUT@A(WX,WY)-(WX+XN,WY+YN),VA,,,,,EM(L):RETURN
  601. 5920 *面塗 LINE(BX,BY)-(BX2,BY2),PASTEL,[M(0,0),M(0,1),M(0,2)],BF:RETURN
  602. 5930 *WAVEX GOSUB *WI3
  603. 5940 FOR I=0 TO BX3:GET@A(0,I)-(BX3,I),B
  604. 5950 X=(COS(3.14159!/19*I)*16) AND 127:PUT@A(X,I)-(BX3+X,I),B
  605. 5960 X=X-128:PUT@A(X,I)-(BX3+X,I),B
  606. 5970 NEXT:GOTO *WO
  607. 5980 *WAVEY GOSUB *WI3
  608. 5990 FOR I=0 TO BY3:GET@A(I,0)-(I,BY3),B
  609. 6000 X=(COS(3.14159!/19*I)*16) AND 127:PUT@A(I,X)-(I,BY3+X),B
  610. 6010 X=X-128:PUT@A(I,X)-(I,BY3+X),B
  611. 6020 NEXT:GOTO *WO
  612. 6030 *連続 MOUSE 1,160-BX4/2,120-BY4/2,0
  613. 6040 FOR I=0 TO EV-1:SIMPOSE ON 0:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF
  614. 6050 X2=MOUSE(0):Y2=MOUSE(1)
  615. 6060 LINE(X2-1,Y2-1)-(X2+BX4,Y2+BY4),PSET,6,B
  616. 6070 X2=X:Y2=Y:X=MOUSE(0):Y=MOUSE(1)
  617. 6080 IF X2=X AND Y2=Y THEN 6110
  618. 6090 LINE(X2-1,Y2-1)-(X2+BX4,Y2+BY4),PSET,[0,0,0,1],B
  619. 6100 LINE(X-1,Y-1)-(X+BX4,Y+BY4),PSET,6,B
  620. 6110 IF MOUSE(2,0)=0 AND INKEY$="" THEN 6070
  621. 6120 SIMPOSE 3:FOR EX=0 TO 120:NEXT
  622. 6130 GET@A(X,Y)-(X+BX3,Y+BY3),V,I*BX4*BY4
  623. 6140 IF MOUSE(2,0) THEN 6140
  624. 6150 NEXT
  625. 6160 IF MOUSE(2,0) THEN 6160 ELSE RETURN *S1
  626. 6170 *MAZE FOR Y=0 TO YN:D(0)=0:D(1)=0:D(2)=0
  627. 6180 GET@A(WX,WY+Y)-(WX+XN,WY+Y),B
  628. 6190 FOR X=0 TO XN:I=B(X) AND 32767
  629. 6200 D(0)=D(0)+((I\1024) AND 31)
  630. 6210 D(1)=D(1)+((I\32) AND 31)
  631. 6220 D(2)=D(2)+(I AND 31)
  632. 6230 NEXT:D(0)=D(0)/(XN+1)
  633. 6240 D(1)=D(1)/(XN+1)
  634. 6250 D(2)=D(2)/(XN+1)
  635. 6260 B(0)=D(0)*1024+D(1)*32+D(2)
  636. 6270 PUT@A(WX,WY+Y)-(WX,WY+Y),B,,XN+1
  637. 6280 NEXT:GOTO *拡大
  638. 6290 *連続2 SIMPOSE 3:OUT &H440,27:OUT &H442,23,2
  639. 6300 FOR I=0 TO EV-1
  640. 6310 IF MOUSE(2,0)=0 AND INKEY$="" THEN 6310
  641. 6320 GET@A(80-BX4/2,0)-(80-BX4/2+BX3,BY3),V,I*BX4*BY4
  642. 6330 IF MOUSE(2,0) THEN 6330
  643. 6340 NEXT
  644. 6350 SIMPOSE OFF:RETURN *S1
  645. 6360 *ANIM GOSUB *ESCG
  646. 6370 FOR I=0 TO EV-1
  647. 6380 PUT@A(BX,BY)-(BX2,BY2),V,,,,,I*BX4*BY4
  648. 6390 WAIT 2:NEXT
  649. 6400 GOTO *ESCP
  650. 6410 *FANT GOSUB *MMI:GOSUB *MUON:GOSUB *PEI:I=1
  651. 6420 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  652. 6430 IF MOUSE(2,0)=0 THEN 6420
  653. 6440 I=I+2:IF I>8000 THEN 6510
  654. 6450 IF MOUSE(2,0) THEN 6450
  655. 6460 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  656. 6470 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  657. 6480 IF MOUSE(2,0) THEN 6440
  658. 6490 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  659. 6500 IF MOUSE(2,1)=0 OR I=3 THEN 6460
  660. 6510 I=I-2:D(0)=(I-1)/2:GOSUB *ESC2:I=8192
  661. 6520 IF MOUSE(2,0) THEN 6520
  662. 6530 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  663. 6540 IF MOUSE(2,0)=0 THEN 6530
  664. 6550 I=I+2:D(0)=D(0)-1:IF D(0)=-1 THEN 6620
  665. 6560 IF MOUSE(2,0) THEN 6560
  666. 6570 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  667. 6580 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  668. 6590 IF MOUSE(2,0) THEN 6550
  669. 6600 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  670. 6610 GOTO 6570
  671. 6620 I=I-2:GOSUB *ESC:EX=(I-8192)/2
  672. 6630 GOSUB *MO:GOSUB *MUSTP
  673. 6640 Z=EV-1:FOR I=0 TO Z
  674. 6650 FOR EY=0 TO EX-1
  675. 6660 LINE(D(EY*2+1)+(D(EY*2+8192)-D(EY*2+1))/Z*I,D(EY*2+2)+(D(EY*2+8193)-D(EY*2+2))/Z*I)-(D(EY*2+3)+(D(EY*2+8194)-D(EY*2+3))/Z*I,D(EY*2+4)+(D(EY*2+8195)-D(EY*2+4))/Z*I),PSET,[M(0,0),M(0,1),M(0,2)]
  676. 6670 NEXT:GOSUB *ESC:NEXT:GOSUB *WO:GOTO *MUON
  677.